home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
progjour
/
1991
/
02
/
xmsdump.pas
< prev
Wrap
Pascal/Delphi Source File
|
1990-10-31
|
8KB
|
229 lines
program XmsDump;
const
ExhaustiveXms : Boolean = False; {True to scan all XMS blocks}
var
XmsControl : Pointer; {Pointer to XMS control procedure}
function XmsInstalledPrim : Boolean;
{-Returns True if an XMS memory manager is installed}
inline(
$B8/$00/$43/ { MOV AX,$4300 ; XMS Installed function}
$CD/$2F/ { INT $2F ; DOS Multiplex int}
$3C/$80/ { CMP AL,$80 ; is it there?}
$75/$04/ { JNE NoXmsDriver}
$B0/$01/ { MOV AL,1 ; return True}
$EB/$02/ { JMP SHORT XIExit}
{NoXmsDriver:}
$30/$C0); { XOR AL,AL ; return False}
{XIExit:}
function XmsControlAddr : Pointer;
{-Return address of XMS control function}
inline(
$B8/$10/$43/ {MOV AX,$4310 ; XMS control func addr}
$CD/$2F/ {INT $2F}
$89/$D8/ {MOV AX,BX ; ptr in ES:BX to DX:AX}
$8C/$C2); {MOV DX,ES}
function QueryFreeExtMem(var TotalFree, LargestBlock : Word) : Byte;
{-Return total free and largest free block of XMS}
var
ErrorCode : Byte;
begin
inline(
$B4/$08/ { MOV AH,$08 ;Query Free ext memory}
$FF/$1E/>XmsControl/ { CALL DWORD PTR [>XmsControl]}
$09/$C0/ { OR AX,AX}
$74/$10/ { JZ SetError}
$30/$DB/ { XOR BL,BL}
$C4/$BE/>TotalFree/ { LES DI,>TotalFree[BP]}
$26/ {ES:}
$89/$15/ { MOV [DI],DX}
$C4/$BE/>LargestBlock/ { LES DI,>LargestBlock[BP]}
$26/ {ES:}
$89/$05/ { MOV [DI],AX}
{SetError:}
$88/$5E/<ErrorCode); { MOV <ErrorCode[BP],BL}
QueryFreeExtMem := ErrorCode;
end;
function GetHandleInfo(XmsHandle : Word;
var LockCount : Byte;
var HandlesLeft : Byte;
var BlockSizeInK : Word) : Byte;
{-Return information about specified XMS handle}
var
ErrorCode : Byte;
begin
inline(
$B4/$0E/ { MOV AH,$0E ;Get EMB Handle Info}
$8B/$96/>XmsHandle/ { MOV DX,>XmsHandle[BP]}
$FF/$1E/>XmsControl/ { CALL DWORD PTR [>XmsControl]}
$A9/$01/$00/ { TEST AX,1}
$74/$17/ { JZ SetError}
$C4/$BE/>LockCount/ { LES DI,>LockCount[BP]}
$26/ {ES:}
$88/$3D/ { MOV BYTE PTR [DI],BH}
$C4/$BE/>HandlesLeft/ { LES DI,>HandlesLeft[BP]}
$26/ {ES:}
$88/$1D/ { MOV BYTE PTR [DI],BL}
$C4/$BE/>BlockSizeInK/ { LES DI,>BlockSizeInK[BP]}
$26/ {ES:}
$89/$15/ { MOV [DI],DX}
$30/$DB/ { XOR BL,BL}
{SetError:}
$88/$5E/<ErrorCode); { MOV <ErrorCode[BP],BL}
GetHandleInfo := ErrorCode;
end;
function AllocateExtMem(SizeInK : Word; var XmsHandle : Word) : Byte;
{-Allocate a block of extended memory}
var
ErrorCode : Byte;
begin
inline(
$B4/$09/ { MOV AH,$09 ;XMS function 09h - Alloc ext memory block}
$8B/$96/>SizeInK/ { MOV DX,>SizeInK[BP]}
$FF/$1E/>XmsControl/ { CALL DWORD PTR [>XmsControl]}
$A9/$01/$00/ { TEST AX,1}
$74/$09/ { JZ SetError}
$30/$DB/ { XOR BL,BL}
$C4/$BE/>XmsHandle/ { LES DI,>XmsHandle[BP]}
$26/ {ES:}
$89/$15/ { MOV [DI],DX ;return XMS handle}
{SetError:}
$88/$5E/<ErrorCode); { MOV <ErrorCode[BP],BL}
AllocateExtMem := ErrorCode;
end;
function FreeExtMem(XmsHandle : Word) : Byte;
{-Free a block of extended memory given its handle}
var
ErrorCode : Byte;
begin
inline(
$B4/$0A/ { MOV AH,$0A ;XMS function 0Ah - Free ext memory block}
$8B/$96/>XmsHandle/ { MOV DX,>XmsHandle[BP]}
$FF/$1E/>XmsControl/ { CALL DWORD PTR [>XmsControl]}
$A9/$01/$00/ { TEST AX,1}
$74/$02/ { JZ SetError}
$30/$DB/ { XOR BL,BL}
{SetError:}
$88/$5E/<ErrorCode); { MOV <ErrorCode[BP],BL}
FreeExtMem := ErrorCode;
end;
procedure ShowTheXmsMemory;
{-Report on allocated extended memory}
label
ExitPoint;
var
H0 : Word;
H1 : Word;
H : Word;
Delta : Integer;
HNum : Word;
HMem : Word;
FMem : Word;
FMax : Word;
Total : Word;
Status : Byte;
LockCount : Byte;
HandlesLeft : Byte;
Done : Boolean;
begin
if XmsInstalledPrim then
XmsControl := XmsControlAddr
else begin
WriteLn('No XMS driver installed');
Exit;
end;
Status := QueryFreeExtMem(FMem, FMax);
if Status = $A0 then begin
{All XMS has been allocated}
FMem := 0;
FMax := 0;
end else if Status <> 0 then begin
WriteLn('Error ', Status, ' accessing XMS');
Exit;
end;
WriteLn('block bytes (XMS Memory)');
WriteLn('----- ------');
{Total will count total XMS memory}
Total := 0;
{HNum will list the XMS handles in sequential order}
HNum := 0;
if ExhaustiveXms then begin
{Search all 64K XMS handles for valid ones}
for H := 0 to 65535 do begin
Status := GetHandleInfo(H, LockCount, HandlesLeft, HMem);
if Status = 0 then begin
WriteLn(HNum:5, ' ', LongInt(1024)*HMem:7);
inc(Total, HMem);
inc(HNum);
end;
end;
end else begin
{Heuristic algorithm to report used handles quickly}
{Allocate two dummy handles}
if FMem > 1 then
HMem := 1
else
HMem := 0;
Status := AllocateExtMem(HMem, H0);
if Status <> 0 then
goto ExitPoint;
Status := AllocateExtMem(HMem, H1);
if Status <> 0 then begin
{Deallocate dummy handle}
Status := FreeExtMem(H0);
goto ExitPoint;
end;
Delta := H1-H0;
{Deallocate one dummy}
Status := FreeExtMem(H1);
{Trace back through valid handles}
H := H0;
repeat
Status := GetHandleInfo(H, LockCount, HandlesLeft, HMem);
Done := (Status <> 0);
if not Done then
dec(H, Delta);
until Done;
{Go forward again through valid handles, reporting them}
inc(H, Delta);
while H <> H0 do begin
Status := GetHandleInfo(H, LockCount, HandlesLeft, HMem);
if Status = 0 then begin
WriteLn(HNum:5, ' ', LongInt(1024)*HMem:7);
inc(Total, HMem);
inc(HNum);
end;
inc(H, Delta);
end;
{Deallocate dummy handle}
Status := FreeExtMem(H0);
end;
inc(Total, FMem);
ExitPoint:
WriteLn(' free ', LongInt(1024)*FMem:7);
if Total <> 0 then
WriteLn('total ', LongInt(1024)*Total:7);
end;
begin
ShowTheXmsMemory;
end.